home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / scheme / ramanujan < prev    next >
Encoding:
Text File  |  1992-10-27  |  1.1 KB  |  45 lines
  1. ;;; -*-Scheme-*-
  2.  
  3. (define (sqrt-of a base)
  4.   (do ((old 0) (xn (* a base base)) (an (* a base base)))
  5.       ((equal? old xn) xn)
  6.     (begin
  7.       (set! old xn)
  8.       (set! xn (quotient (+ xn (quotient an xn)) 2)))))
  9.  
  10. ; pi = 9801/(sqrt(8) * sum(...))
  11. (define (rama base)
  12.   (define (step n)
  13.     (quotient (* base (* (fact (* 4 n)) (+ 1103 (* 26390 n))))
  14.           (* (expt (fact n) 4) (expt 396 (* 4 n)))))
  15.   (do ((i 0 (+ i 1))
  16.        (sum 0 (+ sum delta))
  17.        (delta 1 (step i)))
  18.       ((zero? delta)
  19.        sum)))
  20.  
  21. (define (calc-pi-ramanujan base)
  22.   (quotient (* base base base 9801) (* (sqrt-of 8 base) (rama base))))
  23.  
  24. (define (fact n)
  25.   (let f ((i n) (a 1))
  26.     (if (zero? i)
  27.     a
  28.     (f (- i 1) (* a i)))))
  29.  
  30. (define (square x) (* x x))
  31.  
  32. (define base
  33.   (let ((d (format #t "How many decimals of pi do you want (0 to exit): "))
  34.     (num (read)))
  35.     (if (and (not (eof-object? num)) (positive? num))
  36.     (let* ((extra (+ 5 (truncate (log num)))))
  37.       (cons (expt 10 (+ num extra)) extra)))))
  38.       
  39. (define (print-pi pi base)
  40.   (format #t "~a.~a~%"
  41.       (quotient pi (car base))
  42.       (quotient (remainder pi (car base)) (expt 10 (cdr base)))))
  43.  
  44. (print-pi (calc-pi-ramanujan (car base)) base)
  45.